home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / dejagnu.lha / dejagnu-1.0.1 / tcl / tests / env.test < prev    next >
Text File  |  1992-11-06  |  3KB  |  103 lines
  1. # Commands covered:  none (tests environment variable implementation)
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright 1991 Regents of the University of California
  8. # Permission to use, copy, modify, and distribute this
  9. # software and its documentation for any purpose and without
  10. # fee is hereby granted, provided that this copyright notice
  11. # appears in all copies.  The University of California makes no
  12. # representations about the suitability of this software for any
  13. # purpose.  It is provided "as is" without express or implied
  14. # warranty.
  15. #
  16. # $Header: /sprite/src/lib/tcl/tests/RCS/env.test,v 1.4 91/09/16 14:39:47 ouster Exp $ (Berkeley)
  17.  
  18. if {[string compare test [info procs test]] == 1} then {source defs}
  19.  
  20. # If there is no "printenv" program on this system, then it's just too
  21. # much trouble to run this test (can't necessarily run csh to get the
  22. # envionrment:  on some systems it barfs if there isn't a minimum set
  23. # predefined environment variables.  Also, printenv returns a non-zero
  24. # status on some systems, so read the environment using a procedure
  25. # that catches errors.
  26.  
  27. set printenv {}
  28. if [info exists env(PATH)] {
  29.     set dirs [split $env(PATH) :]
  30. } else {
  31.     set dirs {/bin /usr/bin /usr/ucb /usr/local /usr/public /usr/etc}
  32. }
  33. foreach i $dirs {
  34.     if [file executable $i/printenv] {
  35.     set printenv $i/printenv
  36.     break
  37.     }
  38. }
  39. if {$printenv == ""} {
  40.     puts stdout "Skipping env tests:  need \"printenv\" to read environment."
  41.     return ""
  42. }
  43. proc getenv {} {
  44.     global printenv
  45.     catch {exec $printenv} out
  46.     return $out
  47. }
  48.  
  49. # Save the current environment variables at the start of the test.
  50.  
  51. foreach name [array names env] {
  52.     set env2($name) $env($name)
  53.     unset env($name)
  54. }
  55.  
  56. test env-1.1 {adding environment variables} {
  57.     getenv
  58. } {}
  59.  
  60. set env(NAME1) "test string"
  61. test env-1.2 {adding environment variables} {
  62.     getenv
  63. } {NAME1=test string}
  64.  
  65. set env(NAME2) "more"
  66. test env-1.3 {adding environment variables} {
  67.     getenv
  68. } {NAME1=test string
  69. NAME2=more}
  70.  
  71. set env(XYZZY) "garbage"
  72. test env-1.4 {adding environment variables} {
  73.     getenv
  74. } {NAME1=test string
  75. NAME2=more
  76. XYZZY=garbage}
  77.  
  78. set env(NAME2) "new value"
  79. test env-2.1 {changing environment variables} {
  80.     getenv
  81. } {NAME1=test string
  82. NAME2=new value
  83. XYZZY=garbage}
  84.  
  85. unset env(NAME2)
  86. test env-3.1 {unsetting environment variables} {
  87.     getenv
  88. } {NAME1=test string
  89. XYZZY=garbage}
  90. unset env(NAME1)
  91. test env-3.2 {unsetting environment variables} {
  92.     getenv
  93. } {XYZZY=garbage}
  94.  
  95. # Restore the environment variables at the end of the test.
  96.  
  97. foreach name [array names env] {
  98.     unset env($name)
  99. }
  100. foreach name [array names env2] {
  101.     set env($name) $env2($name)
  102. }
  103.